home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / tut18 / fpack.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-01-28  |  3.6 KB  |  174 lines
  1. UNIT FPack;
  2.  
  3. INTERFACE
  4.  
  5. USES crt;
  6.  
  7. VAR InfoDat : array [1..25] of string[12];
  8.       Total : Integer;
  9.  
  10. Function LoadData (num:integer; p:pointer):Boolean;
  11.   { Load raw data into data at pointer "p" }
  12. Function LoadCel  (num:integer; p:pointer):Boolean;
  13.   { Load in a cel into pointer "p" }
  14. Function LoadPCX  (num:integer; where:word; dopal : Boolean):Boolean;
  15.   { Load a PCX file to the screen "where"
  16.     Dopal = True sets up the correct PCX pallette, otherwise it leaves
  17.             the pallette alone }
  18.  
  19. IMPLEMENTATION
  20.  
  21.  
  22. VAR pack:boolean;
  23.     InfoPos:Array[1..25] of longint;
  24.  
  25. Procedure DoSinglePal(Col,R,G,B : Byte); assembler;
  26. asm
  27.    mov    dx,3c8h
  28.    mov    al,[col]
  29.    out    dx,al
  30.    inc    dx
  31.    mov    al,[r]
  32.    out    dx,al
  33.    mov    al,[g]
  34.    out    dx,al
  35.    mov    al,[b]
  36.    out    dx,al
  37. end;
  38.  
  39.  
  40. Function LoadData (num:integer; p:pointer):Boolean;
  41. VAR f:file;
  42. BEGIN
  43.   If num>Total then BEGIN
  44.     LoadData:=FALSE;
  45.     exit;
  46.   END;
  47.   If pack then BEGIN
  48.     assign (f,paramstr(0));
  49.     reset (f,1);
  50.     seek (f,infopos[num]);
  51.     blockread (f, p^, infopos[num+1]-infopos[num]);
  52.     close (f);
  53.   END else BEGIN
  54.     assign (f,infodat[num]);
  55.     reset (f,1);
  56.     blockread (f, p^, filesize (f));
  57.     close (f);
  58.   END;
  59. END;
  60.  
  61. Function LoadCel (num:integer; p:pointer):Boolean;
  62. VAR f:file;
  63. BEGIN
  64.   If num>Total then BEGIN
  65.     LoadCel:=FALSE;
  66.     exit;
  67.   END;
  68.   If pack then BEGIN
  69.     assign (f,paramstr(0));
  70.     reset (f,1);
  71.     seek (f,infopos[num]+800);
  72.     blockread (f, p^, infopos[num+1]-infopos[num]-800);
  73.     close (f);
  74.   END else BEGIN
  75.     assign (f,infodat[num]);
  76.     reset (f,1);
  77.     seek (f,800);
  78.     blockread (f, p^, filesize (f));
  79.     close (f);
  80.   END;
  81. END;
  82.  
  83. Function LoadPCX (num:integer; where:word; dopal : Boolean):Boolean;
  84. VAR f:file;
  85.     res,loop1:word;
  86.     temp:pointer;
  87.     pallette: Array[0..767] Of Byte;
  88. BEGIN
  89.   If num>Total then BEGIN
  90.     LoadPCX:=FALSE;
  91.     exit;
  92.   END;
  93.   If pack then BEGIN
  94.     assign (f,paramstr(0));
  95.     reset (f,1);
  96.     if dopal then BEGIN
  97.       Seek(f,infopos[num+1]-768);
  98.       BlockRead(f,pallette,768);
  99.       For loop1:=0 To 255 Do
  100.         dosinglepal (loop1,pallette[loop1*3] shr 2,pallette[loop1*3+1] shr 2,pallette[loop1*3+2] shr 2);
  101.     END;
  102.     seek (f,infopos[num]+128);
  103.   END else BEGIN
  104.     assign (f,infodat[num]);
  105.     reset (f,1);
  106.     if dopal then BEGIN
  107.       Seek(f,FileSize(f)-768);
  108.       BlockRead(f,pallette,768);
  109.       For loop1:=0 To 255 Do
  110.         dosinglepal (loop1,pallette[loop1*3] shr 2,pallette[loop1*3+1] shr 2,pallette[loop1*3+2] shr 2);
  111.     END;
  112.     seek (f,128);
  113.   END;
  114.   getmem (temp,65535);
  115.   blockread (f,temp^,65535,res);
  116.   asm
  117.     push ds
  118.     mov  ax,where
  119.     mov  es,ax
  120.     xor  di,di
  121.     xor  ch,ch
  122.     lds  si,temp
  123. @Loop1 :
  124.     lodsb
  125.     mov  bl,al
  126.     and  bl,$c0
  127.     cmp  bl,$c0
  128.     jne  @Single
  129.  
  130.     mov  cl,al
  131.     and  cl,$3f
  132.     lodsb
  133.     rep  stosb
  134.     jmp  @Fin
  135. @Single :
  136.     stosb
  137. @Fin :
  138.     cmp  di,63999
  139.     jbe  @Loop1
  140.     pop  ds
  141.   end;
  142.   freemem (temp,65535);
  143.   close (f);
  144. END;
  145.  
  146.  
  147.  
  148.  
  149. Procedure Startup;
  150. CONST header : String[42] = '(c) Asphyxia 1995 The Asphyxia File Packer';
  151. VAR buf : String[43];
  152.     f : file;
  153.     ch:byte;
  154. BEGIN
  155.   Total:=0;
  156.   Fillchar (infodat, sizeof(infodat), 0);
  157.   assign (f,paramstr(0));
  158.   reset (f,1);
  159.   seek (f,filesize(f)-43);
  160.   blockread (f,buf,43);
  161.   if buf=header then BEGIN
  162.     seek (f,filesize(f)-44-100);
  163.     blockread (f,ch,1);
  164.     blockread (f,infopos,sizeof(infopos));
  165.     Pack:=TRUE;
  166.   END else BEGIN
  167.     Pack:=FALSE;
  168.   END;
  169.   close (f);
  170. END;
  171.  
  172. BEGIN
  173.   Startup;
  174. END.